module Metrics  where
import IO
import qualified Data.Set as Set

-- Quick sort
sort :: Ord a => [a] -> [a]
sort [] = []
sort (a:as) = (sort [b | b<-as, b<=a]) ++ [a] ++ (sort [b | b<-as, b>a])

-- Util function: 
-- on input we have tuples with the same first element
-- on output is the single tuple with the second elements in the single array
joinGroup :: [(a,b)] -> (a,[b])
joinGroup ((a,b):t) = (a, b:(map snd t))

--
joinGroups :: [[(a,b)]] -> [(a,[b])]
joinGroups = map joinGroup

-- Splits input array into disjunctive subarrays
-- using the communicative predicate function
-- From "AAABBCCAAA" we get ["AAAAAA", "BB", "CCC"]
-- (order is not preserved)
group :: (a->a->Bool) -> [a] -> [[a]]
group f = g [] where
	g result [] = result
	g result (h:t) = g (newGroup:result) rest where
		newGroup = h:(filter (f h) t)
		rest = filter (not.f h) t

-- Splits input array into consequent subarrays using function:
-- From "AAABBCCAAA" we get ["AAA", "BB", "CCC", "AAA"] 
-- (order is not preserved)
groupNeighbs :: (a->a->Bool) -> [a] -> [[a]]
groupNeighbs f  = g [] []  where
	g result [] [] = result
	g result [] (a:as) = g result [a] as
	g result buf [] = buf : result
	g result buf (a:as)  = 
		if (f a $ head buf) then g result (a:buf) as 
			else g (buf:result) [a] as


skipWhile :: (a->Bool) -> [a] -> [a]
skipWhile _ [] = []
skipWhile f (a:as) = if (f a) then skipWhile f as else (a:as)

groupAreals :: Ord k => (a->k) -> [a] -> [[a]]
groupAreals f  = ga Set.empty [] where
--	ga :: Ord k => (Set.Set k) -> [[a]] -> [a] -> [[a]]
	ga _ result [] = result
	ga mem result as = let 
		skH = skipWhile (\a->(Set.member (f a) mem)) as;
		skT = reverse (skipWhile (\a -> (f a)/=(f $ head skH)) (reverse skH))
		newResult = if (length skT)==0 then result else result ++ [skT]
		in ga (Set.insert (f $ head skT) mem) (newResult) skH

entropy :: (e->Bool) -> (e->Double) -> [e] -> Double
entropy f w dat = let
	wMap = map (\e -> (e, w e)) dat;
	baseW = sum $ map snd wMap;
	selW = map snd $ filter (f . fst) wMap
	in sum $ map (\x -> epy (x / baseW)) selW
	where epy x = -x*(log x)/(log 2)


-- Util function to group tuples by the first elem
same1st :: Eq a => (a,b) -> (a,c) -> Bool
same1st (a1,_) (a2,_) = a1 == a2

joinNeighbsBy1st :: Eq a => [(a,b)]->[(a,[b])]
joinNeighbsBy1st = joinGroups . groupNeighbs same1st

joinBy1st :: Eq a => [(a,b)]->[(a,[b])]
joinBy1st = joinGroups . group same1st

--groupEntropy :: ([b]->Double) -> [(a,[b])] -> Double
--groupEntropy f = entropy . probabilities f . map snd

-- Get probability of disjunctive event sequence 
-- by their relative measure
probabilities :: ([b]->Double) -> [[b]] -> [Double]
probabilities f arr = map (\x-> (f x)/total) arr where
	total = sum $ map f arr


-----------------------------
type Metrics a b = (Weight [b]) -> [(a,b)] -> Double

blending :: Eq a => Metrics a b
blending w dat = let grp = joinBy1st dat in
	entropy (\x ->True) (w . snd) grp

fragmentation :: Eq a => Metrics a b
fragmentation w dat = let grp = joinNeighbsBy1st dat in
	entropy (\x ->True) (w . snd) grp

dispersion :: Eq a => Metrics a b
dispersion w dat = let 
	grp = joinNeighbsBy1st dat;
	ownGroups = group same1st grp 
	in sum $ map (entropy (\x->True) (w.snd)) ownGroups
	
disturbance :: Ord a => Metrics a b
disturbance w dat = let
	grp = joinNeighbsBy1st dat;
	ownGroups = groupAreals fst grp
	in sum $ map ( 
		\g -> entropy (same1st (head g)) (w.snd) g) ownGroups

----------------------------
type Weight a = a -> Double
	
charsWeight :: Weight [String]
charsWeight = fromIntegral . sum . map length

linesWeight :: Weight [String]
linesWeight = fromIntegral . length 
